perm filename PRCAUX.SAI[AL,HE] blob
sn#290115 filedate 1977-06-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 PROCESS AUXILIARIES
C00003 00003 ! Command, new_command
C00005 00004 ! crcall
C00006 00005 ! tresume,prcerr
C00007 00006 ! rec_resume
C00008 ENDMK
C⊗;
COMMENT PROCESS AUXILIARIES;
ENTRY;
BEGIN "PRCAUX"
REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "MACROS.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "IOMODX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "SYS:PROCES.DEF" SOURCE_FILE;
REQUIRE "LEPAUX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "REFBTS.DEF[AL,HE]" SOURCE_FILE;
REQUIRE "PRCAUX.HDR[AL,HE]" SOURCE_FILE;
! Command, new_command;
INTERNAL RECORD_CLASS COMMAND(ITEMVAR OP;
RECORD_POINTER(ANY_CLASS) REC;
INTEGER INT);
INTERNAL RECORD_POINTER(COMMAND) PROCEDURE NEW_COMMAND(
ITEMVAR OP;
RECORD_POINTER(ANY_CLASS) REC(NULL_RECORD);
INTEGER INT(0));
BEGIN
RECORD_POINTER(COMMAND) NC;
NC←NEW_RECORD(COMMAND);
COMMAND:OP[NC]←OP;
COMMAND:REC[NC]←REC;
COMMAND:INT[NC]←INT;
RETURN(NC);
END;
INTERNAL PROCEDURE MK_STDCMD(REFERENCE ITEMVAR IDI;
REFERENCE RECORD_POINTER(COMMAND) IDR;
STRING ID);
BEGIN
IDR←NEW_RECORD(COMMAND);
COMMAND:OP[IDR]←IDI←NEW(IDR);
NEW_PNAME(IDI,ID);
END;
STDCMD(INTERNAL,OK); ! a common result;
STDCMD(INTERNAL,LOSER); ! a common result;
STDCMD(INTERNAL,DIE); ! go commit suicide;
STDCMD(INTERNAL,GET_STATUS,GTSTS); ! asks for internal status info
(may have various meanings);
STDCMD(INTERNAL,GET_NEXT,GTNXT); ! asks for next element from record generator;
! crcall;
INTERNAL SIMPLE BOOLEAN PROCEDURE CRCALL;
START_CODE
EXTERNAL INTEGER SPROUT;
MOVE 1,('12); ! dyn link of caller;
HLRZ 1,1(1); ! look at pda of this guy;
HRRZ 1,(1);
CAIE 1,SPROUT; ! unfortunately, SPRPDA may move;
TDZA 1,1;
MOVEI 1,1;
END;
! tresume,prcerr;
INTERNAL ITEMVAR SIMPROC TRESUME(ITEMVAR P,V;INTEGER OPT(0));
BEGIN
PRINT(" PROCESS ",MYPROC," DOES RESUME(",P,",",V,",'",CVOS(OPT),")"&CRLF);
V←RESUME(P,V,OPT);
PRINT(" PROCESS ",MYPROC," RESUMED WITH VALUE ",V,CRLF);
RETURN(V);
END;
INTERNAL SIMPROC PRCERR(STRING MSG);
BEGIN
INTEGER CTL;
CTL←GETPRINT;
SETPRINT(NULL,"C");
PRINT("PROCESS ",MYPROC," ERROR:"&CRLF);
PRINT(MSG,CRLF);
IF CTL="F" ∨ CTL="N" ∨ CTL="S" THEN SETPRINT(NULL,"I");
USERERR(1,1,NULL);
END;
! rec_resume;
INTERNAL RECORD_POINTER(ANY_CLASS)
RECURSIVE PROCEDURE REC_RESUME(ITEMVAR PRC;
RECORD_POINTER(ANY_CLASS) REC(NULL_RECORD);
INTEGER OPTS(0));
BEGIN
RECORD_POINTER(ANY_CLASS) ITEMVAR RI;
RI←RESUME(PRC,NEW(REC),OPTS);
IF RI=ANY∨RI=BINDIT THEN
RETURN(NULL_RECORD);
IF TYPEIT(RI)≠REC_CODE THEN
BEGIN
PRCERR("REC_RESUME ("&ITMNAM(PRC)
&") FAILED TO PRODUCE A RECORD ITEM. "
&ITMNAM(RI)&"WAS RETURNED INSTEAD");
RETURN(NULL_RECORD);
END;
REC←∂(RI);
DELETE(RI);
RETURN(REC);
END;
END "PRCAUX"